Developer CD Series 1996 February: Tool Chest/Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso/Sample Code/AOCE Sample Code/PowerTalk Access Modules/Sample SMSAM/SampleSMSAM Source/BuildingBlocks/WriteLineWindow.inc1.p

Text File | 1995-07-28 | 27.2 KB | 1,263 lines | [TEXT/MPS ]

{
    File:        WriteLineWindow.inc1.p

    Contains:    Routines to create and handle a scrollable transcript-type window.
                The expected use of this unit is for a 'debugging' window in an
                application.

                This unit hooks into the MPW 3.2 i/o hooks, so that once the debugging
                window is created, all output from Pascal writeln and C printf statements
                will be placed into this window.

    How to use:
                At the start of your application, call WWInit() and WWNew() or WWNewDefault.
                This will create and show the debugging window.  In the main event loop,
                call WWEvent() after you get an event but before you handle it.  If this
                function returns true, then it was an event associated with the debugging
                window and should be 'ignored' by your application.

                If you want all information sent to the window also written to a file,
                call WWRedirect() or WWFSpRedirect.

                To temporarily suspend output from you application, call the WWForce()
                function.  This saves the current options on a stack and uses the new
                ones.  When you are ready to restore the old options, call WWEndForce().

                You can call WWAddText() to add text to the window directly.

    Written by:    Bruce Horn, Steve Capps, Larry Kenyon,
                John Meier, scott douglass, Darin Adler,
                Paul Mercer, Bryan Stearns, Dave Owens

    Stolen from the Finder by: Keith Stattenfield

    Copyright:    © 1990, 1991 by Apple Computer, Inc., all rights reserved.

    Change History:

        3/23/93     KSS        Change a bunch of integer's to longint's, so that the window can have more than 32K of text.
        11/23/92    KSS        Don't allocate window data in system heap.
        3/9/92      KSS        Make the default deubg window a bit bigger.
        11/25/91    KSS        Periodically flush the file.
        10/30/91    KSS        Add stuff to set end of file.

                 7/25/91    KSS        Added WWNewDefault, WWFSpRedirect, some primitives to insert
                                     and a few 'standard' data types into the window.  Wrote the
                                    Contains: and How to use: sections of this header.

         <5>    10/16/90    sad        fix WWRedirect
         <4>      8/3/90    pm        use NewHandleSys instead of NewHandle to make the memory
                                    difference between debug & SCM builds smaller
        <2+>     3/21/90    prp        Debug window's line array memory is allocated by NewHandleClear
                                    instead NewHandle.

    To Do:
}

{$R-}
{$D+}

CONST
    kWWHMargin = 5;
    kWWVMargin = 10;

    _CODEV = 1;         {console device number}

TYPE    HText = ^PText;
        PText = ^AText;
        AText = PACKED ARRAY [0..10000] OF CHAR;

        HLineLens = ^PLineLens;
        PLineLens = ^ALineLens;
        ALineLens = ARRAY[0..10000] OF LONGINT;

        ForceState = RECORD
            toWindow:    BOOLEAN;
            toFile:     BOOLEAN;
            END;

    IEFilePath =    STRING;
    IEFilePathPtr = ^IEFilePath;

    IEFRefNum =     LONGINT;

VAR gLines:         INTEGER;                        {number of lines saved}
    gPerLine:        INTEGER;                        {number of characters per line}
    gTotal:         LONGINT;                        {number of characters in all lines together}
    gText:            HText;                            {the ring buffer: blanks pad each line to 80 chars}
    gLineLens:        HLineLens;                        {# of real characters in each line; gLinesLens^^[0]
                                                        is # of characters in the line that begins with
                                                        gText^^[0]}

    gFirst:         LONGINT;                        {where in the ring buffer the top line starts}
    gLast:            LONGINT;                        {where in the ring buffer the bottom line starts}
    gPos:            INTEGER;                        {number of characters so far in the bottom line}

    gHeight:        INTEGER;                        {font height}
    gLnAscent:        INTEGER;                        {font ascent}
    gWidMax:        INTEGER;                        {font char width (must be monospaced)}
    gSBars:         ARRAY[VHSelect] OF ControlHandle;    {the window scroll bars}
    gScrollOffset:    Point;                            {the position to which we are scrolled}
    gViewSize:        Point;                            {total view size}
    gEndOfText:     Point;                            {the pen position after drawing all the lines}

    gStdDrag:        Rect;
    gStdSize:        Rect;
    gOrthogonal:    ARRAY[VHSelect] OF VHSelect;
    gWRec:            WindowRecord;
    gARgn:            RgnHandle;

    gGotRefNum:     BOOLEAN;
    gRefNum:        INTEGER;                    {refNum for redirect output}
    gVRefNum:        INTEGER;                    {likewise, vrefNum}

    gForceStack:    ARRAY[1..kForceDepth] OF ForceState;
    gForcePtr:        INTEGER;

    gHexStr:        String[18];
    gScrollWindowWhenTextIsAdded : boolean;

FUNCTION  GetSaveVisRgn: RgnHandle; FORWARD;

PROCEDURE WWInstall; FORWARD;
FUNCTION  WWBaseLine(ln: INTEGER): LONGINT; FORWARD;
PROCEDURE WWDoScrolling; FORWARD;
PROCEDURE WWDraw; FORWARD;
PROCEDURE WWNewLine; FORWARD;
PROCEDURE WWShowPoint(pt: Point); FORWARD;
PROCEDURE WWTrackScroll(aControl: ControlHandle; partCode: INTEGER); FORWARD;


{$S WWSeg}
FUNCTION WWFirstLGlob: LongInt;
BEGIN WWFirstLGlob := ORD(@gLines); END;

{$S WWSeg}
FUNCTION WWLastLGlob: LongInt;
BEGIN WWLastLGlob := ORD(@gForcePtr); END;

{$S WWSeg}
FUNCTION WWFirstGlob: LongInt;
BEGIN WWFirstGlob := ORD(@gDebugWindowPtr); END;

{$S WWSeg}
FUNCTION WWLastGlob: LongInt;
BEGIN WWLastGlob := ORD(@gWrToFile); END;


{$S WWSeg}
FUNCTION  GetSaveVisRgn: RgnHandle;
    CONST    addr    =    $09F2;
    TYPE    pRgn = ^RgnHandle;
    VAR     pSaveVisRgn:    pRgn;
BEGIN
    pSaveVisRgn := pRgn(addr);
    GetSaveVisRgn := pSaveVisRgn^;
END;


{$S WWSeg}
FUNCTION  LongerSide(VAR r: Rect): VHSelect;
BEGIN
    WITH r DO
        IF (bottom - top) >= (left - right) THEN
            LongerSide := v
        ELSE
            LongerSide := h;
END;


{$S WWSeg}
PROCEDURE WindowFocus;
BEGIN
    SetPort(gDebugWindowPtr);
    SetOrigin(0, 0);
    ClipRect(thePort^.portRect);
END;


{$S WWSeg}
PROCEDURE ContentFocus;
    VAR r:    Rect;
BEGIN
    SetPort(gDebugWindowPtr);
    SetOrigin(gScrollOffset.h, gScrollOffset.v);
    r := thePort^.portRect;
    WITH r DO
        BEGIN
        right := right - 15;
        bottom := bottom - 15;
        END;
    ClipRect(r);
END;


{$S WWInit}
PROCEDURE WWInit(numLines, numCharsPerLine: INTEGER);
    VAR i: INTEGER;
BEGIN
    gDebugWindowPtr := NIL;

    gGotRefNum := FALSE;
    gWrToWindow := TRUE;
    gWrToFile := TRUE;
    gScrollWindowWhenTextIsAdded := false;
    WWInstall;

    gForcePtr := 0;

    gLines := numLines;
    gPerLine := numCharsPerLine;
    gTotal := gLines * gPerLine;

    gText := HText(NewHandleClear(gTotal));
    IF gText = NIL THEN
        BEGIN
        WriteLn('Not enough memory to allocate the Debug Window''s Line Array: ', gLines:1, '*', gPerLine:1);
        EXIT(WWInit);
        END;

    gLineLens := HLineLens(NewHandle(gLines*SIZEOF(LONGINT)));
    IF gLineLens = NIL THEN
        BEGIN
        DisposeHandle(Handle(gText));
        WriteLn('Not enough memory to allocate the Debug Window''s LineLen Array: ', gLines:1);
        EXIT(WWInit);
        END;

    FOR i := 0 TO gLines-1 DO
        gLineLens^^[i] := 0;

    gFirst := 0;
    gLast := gTotal - gPerLine;
    gPos := 0;

    gOrthogonal[v] := h;
    gOrthogonal[h] := v;

    gHexStr := '0123456789ABCDEF';
END;


{$S WWInit}
PROCEDURE WWNew(bounds: Rect; windowTitle: Str255; goAway: BOOLEAN; visible: BOOLEAN;
                outputFont, outputSize: INTEGER);
    VAR fInfo:        FontInfo;
        control:    ControlHandle;
        i:            INTEGER;
        aLine:        StringHandle;
        vhs:        VHSelect;
        savePort:    GrafPtr;
BEGIN
    GetPort(savePort);
    IF gDebugWindowPtr = NIL THEN
        BEGIN
        gDebugWindowPtr := NewWindow(nil, bounds, windowTitle, visible, documentProc,
                                    POINTER(-1), goAway, 0);

        WITH screenBits.bounds DO
            BEGIN
            SetRect(gStdDrag, 4, 24, right - 4, bottom - 4);    {this is suggested in Inside Macintosh}
            SetRect(gStdSize, 20, 20, right, bottom - 20);        {arbitrary Minimum size; Maximum size is screen}
            END;

        gARgn := NewRgn;

        SetPt(gEndOfText, kWWHMargin, WWBaseLine(gLines));

        SetPort(gDebugWindowPtr);
        TextFont(outputFont);
        TextSize(outputSize);
        GetFontInfo(fInfo);

        WITH fInfo DO
            BEGIN
            gHeight := ascent + descent + leading;
            gLnAscent := ascent;
            gWidMax := widMax;
            SetPt(gViewSize, (2 * kWWHMargin) + (gPerLine * widMax), (2 * kWWVMargin) + (gHeight * gLines));
            END;

        {scroll bars}
        FOR vhs := v TO h DO
            gSBars[vhs] := NewControl(gDebugWindowPtr, gDebugWindowPtr^.portRect, '', FALSE,
                                0, 0, 1, scrollBarProc, 0);

        {SetPt(gScrollOffset, 0, 0);}
        gScrollOffset := Point(longint(0));

        {put the scroll bars in the right place}
        WWGrown;

        {force an update}
        WWUpdateEvent;

        {scroll to the end, in case there is some information that needs to be displayed}
        SetCtlValue(gSBars[v], MAXINT);
        WWDoScrolling;
        END;
    SetPort(savePort);
END;

{$S WWInit}
PROCEDURE WWNewDefault;
VAR
    aRect    :    Rect;
    title : Str255;
BEGIN
    SetRect (aRect, 620, 40, 1040, 860);

    SetRect (aRect, 16, 40, 16+6*80+16, 40+12*36);
    title := concat(StringPtr(CurApName)^, ' Debug Window');
    WWNew (aRect, title, true, true, 1, 9);
END;



{$S WWSeg}
PROCEDURE WWActivateEvent(modifiers: INTEGER);
    VAR r:            Rect;
        vhs:        VHSelect;
        anSBar:     ControlHandle;
        savePort:    GrafPtr;
BEGIN
    GetPort(savePort);

    WindowFocus;

    r := thePort^.portRect;

    FOR vhs := v TO h DO
        BEGIN
        anSBar := gSBars[vhs];
        IF Odd(modifiers) THEN
            ShowControl(anSBar)
        ELSE
            HideControl(anSBar);
        END;

    DrawGrowIcon(gDebugWindowPtr);

    SetPort(savePort);
END;


{$S WWSeg}
PROCEDURE WWAddText(textBuf: Ptr; byteCount: longint);
    CONST BS = 8;
    VAR gotEOL:     BOOLEAN;
        b:            QDByte;
        startPtr:    Ptr;
        startCount: INTEGER;
        ps:         PenState;
        savePort:    GrafPtr;
        deleted:    BOOLEAN;
        r:            Rect;

        count:        LONGINT;
        err : OSErr;
        filePos : longint;
BEGIN
    IF gWrToFile THEN
        IF gGotRefNum THEN
            BEGIN
            count := byteCount;
            IF FSWrite(gRefNum, count, textBuf) <> noErr THEN
                BEGIN
                {??? do something here ???}
                END;
            if GetFPos (gRefNum, filePos) = noErr then
                if SetEOF (gRefNum, filePos) = noErr then
                    WWFlushOutputFile;
            END;

    IF gWrToWindow THEN
        BEGIN
        IF gDebugWindowPtr <> NIL THEN
            GetPort(savePort);

        deleted := FALSE;

        WHILE byteCount > 0 DO
            BEGIN
            gotEOL := FALSE;
            startPtr := textBuf;
            startCount := byteCount;

            WHILE (byteCount > 0) AND (gPos < gPerLine) AND (NOT gotEOL) DO
                BEGIN
                b := QDPtr(textBuf)^;
                byteCount := byteCount - 1;
                textBuf := Ptr(LONGINT(textBuf) + 1);

                IF b = ORD(kWWEol) THEN
                    gotEOL := TRUE
                ELSE IF b <> BS THEN
                    BEGIN
                    gText^^[gLast+gPos] := CHAR(b);
                    gPos := gPos + 1;
                    END
                ELSE IF gPos > 0 THEN  {Backspace -- don't backspace past beginning of line!}
                    BEGIN
                    WITH gEndOfText DO
                        BEGIN
                        SetRect(r, h - gWidMax, v - gLnAscent, h, v + gHeight - gLnAscent);
                        h := h - gWidMax;
                        END;

                    IF gDebugWindowPtr <> NIL THEN
                        BEGIN
                        ContentFocus;
                        EraseRect(r);
                        END;

                    gPos := gPos - 1;
                    deleted := TRUE;
                    END
                ELSE
                    deleted := TRUE;
                END;

            IF NOT deleted AND (gDebugWindowPtr <> NIL) THEN
                BEGIN
                ContentFocus;
                MoveTo(gEndOfText.h, gEndOfText.v);
                DrawText(QDPtr(startPtr), 0, startCount - byteCount - ORD(gotEOL));
                GetPenState(ps);
                gEndOfText := ps.pnLoc;
                END;

            IF (gPos >= gPerLine) OR gotEOL THEN
                BEGIN
                gLineLens^^[gLast DIV gPerLine] := gPos;    {remember # characters in this line}

                WWNewLine;
                IF (byteCount > 0) AND (NOT gotEOL) THEN
                    BEGIN
                    gText^^[gLast] := '…';
                    gPos := 1;
                    END;
                END;
            END;

        gLineLens^^[gLast DIV gPerLine] := gPos;

        IF gDebugWindowPtr <> NIL THEN
            SetPort(savePort);
        END;
END;

PROCEDURE WWFlushOutputFile;
var
    pb    :    ParamBlockRec;
BEGIN
    if gWrToFile then
        begin
        pb.ioCompletion := nil;
        pb.ioRefNum := gRefNum;
        if PBFlushFile(@pb, false) = noErr then
            ;
        end;
END;


{$S WWSeg}
FUNCTION  WWBaseLine(ln: INTEGER): LONGINT;
BEGIN
    WWBaseLine := kWWVMargin + (ln - 1) * gHeight;
END;


{$S WWSeg}
PROCEDURE WWDoScrolling;
    VAR newOffset:        Point;
        delta:            Point;
BEGIN
    newOffset.v := GetCtlValue(gSBars[v]);
    delta.v := gScrollOffset.v - newOffset.v;
    newOffset.h := GetCtlValue(gSBars[h]);
    delta.h := gScrollOffset.h - newOffset.h;

    IF (delta.h <> 0) OR (delta.v <> 0) THEN
        BEGIN
        ContentFocus;

        ScrollRect(thePort^.portRect, delta.h, delta.v, gARgn);
        gScrollOffset := newOffset;

        InvalRgn(gARgn);

        WWUpdateEvent;
        END;
END;


{$S WWSeg}
PROCEDURE WWDraw;
    VAR i:        INTEGER;
        y:        INTEGER;
        start:    LONGINT;
        line:    INTEGER;
        ps:     PenState;
BEGIN
    y := kWWVMargin;            {initial y corodinate}

    start := gFirst;            {offset to first character of next line to draw}
    line := start DIV gPerLine; {index into gLineLens array for next line to draw; always start DIV gPerLine}

    FOR i := 1 TO gLines DO
        BEGIN
        MoveTo(kWWHMargin, y);

        HLock(Handle(gText));
        DrawText(QDPtr(gText^), start, gLineLens^^[line]);
        HUnlock(Handle(gText));

        y := y + gHeight;
        start := start + gPerLine;
        line := line + 1;

        IF start = gTotal THEN
            BEGIN
            start := 0;
            line := 0;
            END;
        END;

    GetPenState(ps);            {remember position of last character drawn}
    gEndOfText := ps.pnLoc;
END;


{$S WWSeg}
PROCEDURE WWEndForce;
BEGIN
    IF gForcePtr <= 0 THEN
        BEGIN
        END
    ELSE
        BEGIN
        WITH gForceStack[gForcePtr] DO
            BEGIN
            gWrToWindow := toWindow;
            gWrToFile := toFile;
            END;
        gForcePtr := gForcePtr - 1;
        END;
END;


{$S WWSeg}
PROCEDURE WWForceOutput(wrToWindow, wrToFile: WrForceOptions);
BEGIN
    IF gForcePtr >= kForceDepth THEN
        BEGIN
        END
    ELSE
        BEGIN
        gForcePtr := gForcePtr + 1;

        WITH gForceStack[gForcePtr] DO
            BEGIN
            toWindow := gWrToWindow;
            toFile := gWrToFile;
            END;

        IF wrToWindow <> forceUnchanged THEN
            gWrToWindow := wrToWindow = forceOn;

        IF wrToFile <> forceUnchanged tHEN
            gWrToFile := wrToFile = forceOn;
        END;
END;


{$S WWSeg}
PROCEDURE WWGrown;
    VAR r:                Rect;
        vhs:            VHSelect;
        anSBar:         ControlHandle;
        newMax:         INTEGER;
        isVisible:        BOOLEAN;
        savePort:        GrafPtr;
BEGIN
    GetPort(savePort);

    WindowFocus;
    r.topLeft := Point(longint(0));
    r.botRight := Point(longint(0));
    ClipRect(r);

    FOR vhs := v TO h DO
        BEGIN
        anSBar := gSBars[vhs];

        r := thePort^.portRect;

        WITH r DO
            BEGIN
            {Calculate new position of scroll bar}
            topLeft.vh[vhs] := topLeft.vh[vhs] - 1;
            topLeft.vh[gOrthogonal[vhs]] := botRight.vh[gOrthogonal[vhs]] - 15;
            botRight.vh[vhs] := botRight.vh[vhs] - 14;
            botRight.vh[gOrthogonal[vhs]] := topLeft.vh[gOrthogonal[vhs]] + 16;

            {Move the scroll bar}
            MoveControl(anSBar, left, top);
            SizeControl(anSBar, right-left, bottom-top);

            newMax := gViewSize.vh[vhs] - (bottom - top);
            IF newMax < 0 THEN
                newMax := 0;
            SetCtlMax(anSBar, newMax);
            END;
        END;

    WWInvalGrowBox;

    WWDoScrolling;    {in case we are showing too much white space}

    SetPort(savePort);
END;


{$S WWSeg}
PROCEDURE WWInvalGrowBox;
    VAR r:    Rect;
BEGIN
    r.botRight := thePort^.portRect.botRight;
    WITH r DO
        BEGIN
        top := bottom - 15;
        left := right - 15;
        END;
    InvalRect(r);
END;


{$S WWSeg}
PROCEDURE WWMouseDown(where: INTEGER; pt: Point; modifiers: INTEGER);
    VAR r:                Rect;
        sizeStuff:        RECORD CASE INTEGER OF
                            1:    (growResult: LONGINT);        {Information returned by GrowRect}
                            2:    (newV,                        {new vertical size}
                                 newH: INTEGER);            {new horizontal size}
                            3:    (newSize: Point);            {new size as a point}
                        END;
        partCode:        INTEGER;
        whichControl:    ControlHandle;
        oldSize:        Point;
        savePort:        GrafPtr;
BEGIN
    GetPort(savePort);

    CASE where OF
        inDrag:
            DragWindow(gDebugWindowPtr, pt, gStdDrag);

        inGrow:
            BEGIN
            WindowFocus;

            WITH sizeStuff DO
                BEGIN
                WITH gDebugWindowPtr^.portRect, oldSize DO
                    BEGIN
                    h := right - left;
                    v := bottom - top;
                    END;

                growResult := GrowWindow(gDebugWindowPtr, pt, gStdSize);
                IF growResult <> 0 THEN
                    BEGIN
                    WWInvalGrowBox;
                    SizeWindow(gDebugWindowPtr, newH, newV, TRUE);
                    WWGrown;
                    END;
                END;
            END;

        inGoAway:
            IF TrackGoAway(gDebugWindowPtr, pt) THEN
                HideWindow(gDebugWindowPtr);

        inContent:
            IF gDebugWindowPtr = FrontWindow THEN
                BEGIN
                WindowFocus;

                GlobalToLocal(pt);
                partCode := FindControl(pt, gDebugWindowPtr, whichControl);
                IF partCode <> 0 THEN
                    CASE partCode OF
                        inUpButton, inDownButton, inPageUp, inPageDown:
                            partCode := TrackControl(whichControl, pt, @WWTrackScroll);
                        inThumb:
                            BEGIN
                            partCode := TrackControl(whichControl, pt, NIL);
                            WWDoScrolling;
                            END;
                        END;
                END
            ELSE
                SelectWindow(gDebugWindowPtr);
        END;  {CASE}

    SetPort(savePort);
END;


{$S WWSeg}
PROCEDURE WWNewLine;
    VAR savePort:        GrafPtr;
        i:                INTEGER;
        pt:             Point;
        r:                Rect;
BEGIN
    GetPort(savePort);

    SetPt(pt, kWWHMargin, gEndOfText.v);

    if gScrollWindowWhenTextIsAdded then
        WWShowPoint(pt);

    gLast := gFirst;
    gPos := 0;
    gLineLens^^[gLast DIV gPerLine] := gPos;    {remember # characters in new line}

    gFirst := gFirst + gPerLine;
    IF gFirst = gTotal THEN
        gFirst := 0;

    SetPt(gEndOfText, kWWHMargin, WWBaseLine(gLines));

    IF gDebugWindowPtr <> NIL THEN
        BEGIN
        ContentFocus;
        SetRect(r, kWWHMargin, kWWVMargin - gLnAscent, gViewSize.h, gEndOfText.v + gHeight - gLnAscent);
        ScrollRect(r, 0, -gHeight, gARgn);
        InvalRgn(gARgn);

        WWUpdateEvent;
        END;

    SetPort(savePort);
END;


FUNCTION  WWRedirect(vRefNum: INTEGER; fileName: Str255): OSErr;
    VAR err:    OSErr;
        append: BOOLEAN;
        x:        LONGINT;
BEGIN
    IF gGotRefNum THEN
        BEGIN
            {truncate the file to current position}
        err := GetFPos(gRefNum, x);
        err := SetEOF(gRefNum, x);

        IF FSClose(gRefNum) <> noErr THEN {??? error closing file ???};
        IF FlushVol(NIL, gVRefNum) <> noErr THEN {??? Another fine mess ???};
        gGotRefNum := FALSE;
        END;

    append := POS('>>', fileName) = 1;
    IF append THEN
        Delete(fileName, 1 ,2);

    IF fileName <> '' THEN
        BEGIN
        err := Create(fileName, vRefNum, 'MACA', 'TEXT');

        IF (err = noErr) OR (err = dupFNErr) THEN
            BEGIN
            err := FSOpen(fileName, vRefNum, gRefNum);
            gVRefNum := vRefNum;
            WWRedirect := err;

            gGotRefNum := err = noErr;

            IF gGotRefNum THEN
                IF append THEN
                    BEGIN
                    err := GetEOF(gRefNum, x);
                    err := SetFPos(gRefNum, fsFromStart, x);
                    END
                else
                    err := SetEOF (gRefNum, 0);
            END
        ELSE
            WWRedirect := err;
        END
    ELSE
        WWRedirect := noErr;
END;

FUNCTION  WWFSpRedirect(redirectFile : FSSpec; appendToExistingFile : boolean ): OSErr;
    VAR err:    OSErr;
        append: BOOLEAN;
        x:        LONGINT;
BEGIN
    IF gGotRefNum THEN
        BEGIN
            {truncate the file to current position}
        err := GetFPos(gRefNum, x);
        err := SetEOF(gRefNum, x);

        IF FSClose(gRefNum) <> noErr THEN {??? error closing file ???};
        IF FlushVol(NIL, gVRefNum) <> noErr THEN {??? Another fine mess ???};
        gGotRefNum := FALSE;
        END;

    if (redirectFile.vRefNum = 0) & (redirectFile.parID = 0) then
        err := FindFolder (kOnSystemDisk, kSystemFolderType, kDontCreateFolder, redirectFile.vRefNum, redirectFile.parID);

    IF redirectFile.name <> '' THEN
        BEGIN
        err := FSpCreate(redirectFile, 'MACA', 'TEXT', smRoman);

        IF (err = noErr) OR (err = dupFNErr) THEN
            BEGIN
            err := FSpOpenDF(redirectFile, fsRdWrPerm, gRefNum);
            gVRefNum := redirectFile.vRefNum;
            WWFSpRedirect := err;

            gGotRefNum := (err = noErr);

            IF gGotRefNum THEN
                IF appendToExistingFile THEN
                    BEGIN
                    err := GetEOF(gRefNum, x);
                    err := SetFPos(gRefNum, fsFromStart, x);
                    END;
            END
        ELSE
            WWFSpRedirect := err;
        END
    ELSE
        WWFSpRedirect := noErr;
END;


PROCEDURE WWScroll(howManyLines: INTEGER);
    VAR val:        INTEGER;
        savePort:    GrafPtr;
BEGIN
    GetPort(savePort);
    val := GetCtlValue(gSBars[v]);
    IF ((howManyLines < 0) AND (val > GetCtlMin(gSBars[v]))) OR
       ((howManyLines > 0) AND (val < GetCtlMax(gSBars[v]))) THEN
        BEGIN
        SetCtlValue(gSBars[v], val + howManyLines * gHeight);
        WWDoScrolling;
        END;
    SetPort(savePort);
END;


PROCEDURE WWShowPoint(pt: Point);
    VAR minToSee:    Point;
        deltaCd:    INTEGER;
BEGIN
    IF gDebugWindowPtr <> NIL THEN
        BEGIN
        WindowFocus;

        SetPt(minToSee, 50, gHeight);

        {the following code is actually better than writing a loop with VHSelect}
        WITH thePort^.portRect DO
            BEGIN
            deltaCd := pt.v + mintoSee.v - (bottom - 15 + gScrollOffset.v);
            IF deltaCd <= 0 THEN
                BEGIN
                deltaCd := pt.v - minToSee.v - (top + gScrollOffset.v);
                IF deltaCd >= 0 THEN
                    deltaCd := 0;
                END;
            SetCtlValue(gSBars[v], GetCtlValue(gSBars[v]) + deltaCd);

            deltaCd := pt.h + mintoSee.h - (right - 15 + gScrollOffset.h);
            IF deltaCd <= 0 THEN
                BEGIN
                deltaCd := pt.h - minToSee.h - (left + gScrollOffset.h);
                IF deltaCd >= 0 THEN
                    deltaCd := 0;
                END;
            SetCtlValue(gSBars[h], GetCtlValue(gSBars[h]) + deltaCd);
            END;

        WWDoScrolling;
        END;
END;


{$S WWSeg}
PROCEDURE WWTrackScroll(aControl: ControlHandle; partCode: INTEGER);
    VAR up:         BOOLEAN;
        ctlValue:    INTEGER;
        vhs:        VHSelect;
        r:            Rect;
        delta:        INTEGER;
BEGIN
    IF partCode <> 0 THEN
        BEGIN
        up := (partCode = inUpButton) OR (partCode = inPageUp);
        ctlValue := GetCtlValue(aControl);

      {avoid flicker in setting thumb, IF user tries to scroll past end}
        IF (up AND (ctlValue > GetCtlMin(aControl))) OR
           (NOT up AND (ctlValue < GetCtlMax(aControl))) THEN
            BEGIN
            r := aControl^^.contrlRect;   {heap may compact when we call LongerSide}
            vhs := LongerSide(r);          {this tells us which way we are scrolling}

            IF (partCode = inPageUp) OR (partCode = inPageDown) THEN
                WITH gDebugWindowPtr^.portRect DO
                    delta := botRight.vh[vhs] - topLeft.vh[vhs] - gHeight
            ELSE
                delta := gHeight;

            IF up THEN
                delta := - delta;

            SetCtlValue(aControl, ctlValue + delta);
            WWDoScrolling;

            WindowFocus;
            END;
        END;
END;


{$S WWSeg}
PROCEDURE WWUpdateEvent;
    VAR savePort:        GrafPtr;
        saveSaveVisRgn: RgnHandle;
        saveVisRgn:     RgnHandle;
BEGIN
    if (gDebugWindowPtr <> NIL) AND (NOT EmptyRgn(WindowPeek(gDebugWindowPtr)^.port.visRgn)) THEN BEGIN

        GetPort(savePort);

        saveSaveVisRgn := NewRgn;
        saveVisRgn := GetSaveVisRgn;

        CopyRgn(saveVisRgn, saveSaveVisRgn);

        BeginUpdate(gDebugWindowPtr);

        WindowFocus;

        EraseRect(thePort^.portRect);

        DrawGrowIcon(gDebugWindowPtr);
        DrawControls(gDebugWindowPtr);

        ContentFocus;
        WWDraw;

        EndUpdate(gDebugWindowPtr);

        CopyRgn(saveSaveVisRgn, saveVisRgn);
        DisposeRgn(saveSaveVisRgn);

        SetPort(savePort);
    END;
END;


{$S WWSeg}
FUNCTION WWReadCh: CHAR;
    VAR savePort:    GrafPtr;
        ch:         CHAR;
        anEvent:    EventRecord;
        r:            Rect;
BEGIN
    GetPort(savePort);

    ContentFocus;

    WITH gEndOfText DO
        SetRect(r, h, v - gLnAscent, h + gWidMax, v + gHeight - gLnAscent);

    FillRect(r, black);
    REPEAT UNTIL GetOSEvent(keyDownMask+autoKeyMask, anEvent);
    EraseRect(r);

    ch := CHAR(BAND(anEvent.message, charCodeMask));

    WWReadCh := ch;

    SetPort(savePort);
END;


{$S WWSeg}
FUNCTION WWReadLn(buffer: Ptr; byteCount: INTEGER): LONGINT;
    CONST
        CR = 13;
        BS = 8;
    TYPE    PA1000 = PACKED ARRAY [0..999] OF CHAR;
            StrPtr = ^PA1000;
    VAR ch:     CHAR;
        len:        INTEGER;
BEGIN
    len := 0;
    REPEAT
        ch := WWReadCh;
        IF ORD(ch) <> BS THEN
            BEGIN
            WWAddText(POINTER(ORD(@ch)+1), 1);
            StrPtr(buffer)^[len] := CHAR(ch);
            len := len + 1;
            END
        ELSE IF len > 0 THEN
            BEGIN
            WWAddText(POINTER(ORD(@ch)+1), 1);
            len := len - 1;
            StrPtr(buffer)^[len] := ' ';
            END
   UNTIL (ORD(ch)=CR) OR (len = byteCount);

   WWReadLn := len;
END;


PROCEDURE IDUWritelnWindow; {Writeln UWritelnWindow's compile time.}
BEGIN
    Writeln('UWritelnWindow of ', COMPDATE, ' @ ', COMPTIME);
END;


FUNCTION
    wwFAccess(fName: UNIV IEFilePathPtr; opCode: LONGINT; arg: UNIV LONGINT):
    LONGINT; C; EXTERNAL;
FUNCTION
    wwClose(fdesc: IEFRefNum):
    LONGINT; C; EXTERNAL;
FUNCTION
    wwRead(fdesc: IEFRefNum; bufp: UNIV LONGINT; count: LONGINT):
    LONGINT; C; EXTERNAL;
FUNCTION
    wwWrite(fdesc: IEFRefNum; bufp: UNIV LONGINT; count: LONGINT):
    LONGINT; C; EXTERNAL;
FUNCTION
    wwIoctl(fdesc: IEFRefNum; request: LONGINT; arg: UNIV LONGINT):
    LONGINT; C; EXTERNAL;

FUNCTION
    _addDevHandler(
        slot, dvName, dvFAccess, dvClose, dvRead, dvWrite, dvIoctl: LONGINT):
    LONGINT; C; EXTERNAL;

PROCEDURE WWInstall;
    VAR slot: LONGINT;
BEGIN
    slot := _addDevHandler(_CODEV, 0,
                    ORD(@wwFAccess), ORD(@wwClose),
                    ORD(@wwRead), ORD(@wwWrite),
                    ORD(@wwIoctl));
    PLsetvbuf(output, NIL, 64, 100);
END;


{
--    Paul's Writeln routines  ----------------------------------------------------------------
}
FUNCTION WWEvent(event:EventRecord): Boolean;

VAR
    WindowPointedTo: WindowPtr;        {window where the mouse is}
    MouseLoc:        Point;
    WindoPart:       Integer;        {component of window where mouse is}
    MenuHdl:         MenuHandle;    {holds the menuhandle of selected menu}

BEGIN
    WWEvent := False;            {set the default}

    CASE event.what of
        mouseDown:
            BEGIN
                MouseLoc := event.where;
                WindoPart := FindWindow(MouseLoc, WindowPointedTo);

                IF  (WindowPointedTo = gDebugWindowPtr) THEN
                    BEGIN
                        WWEvent := True;

                        IF (WindowPointedTo <> FrontWindow)
                            THEN SelectWindow(WindowPointedTo)
                        ELSE
                            WWMouseDown(WindoPart, MouseLoc, Event.modifiers);
                    END;
            END;

        ActivateEvt:
            IF WindowPtr(Event.message) = gDeBugWindowPtr THEN
                BEGIN
                    WWActivateEvent(Event.modifiers);
                    WWEvent := True;
                END;

        UpDateEvt:
            IF WindowPtr(Event.message) = gDeBugWindowPtr THEN
                BEGIN
                    WWUpDateEvent;
                    WWEvent := True;
                END;

    END; {of CASE}
END; {FUNCTION WWEvent}

{
--    end Writeln routines  ------------------------------------------------------------
}

{
-- Keith's WriteLineWindow routines --------------------------------------------------
}
PROCEDURE WWAddDate;
VAR
    dateTime : longint;
    tempStr255 : Str255;
BEGIN
    GetDateTime (dateTime);
    IUDateString(dateTime, shortDate, tempStr255);
    write (tempStr255, ' ');
END;

PROCEDURE WWAddTime;
VAR
    dateTime : longint;
    tempStr255 : Str255;
BEGIN
    GetDateTime (dateTime);
    IUTimeString(dateTime, true, tempStr255);
    write (tempStr255, ' ');
END;

PROCEDURE WWAddDateTime;
BEGIN
    WWAddDate;
    WWAddTime;
END;

PROCEDURE WWAddEncodedText (dataPtr : UNIV Ptr; dataSize : integer);
type
    BytePtr = ^Byte;            { this is unsigned! }
VAR
    index        :    integer;
    aByte : integer;
BEGIN
    for index := 0 to dataSize - 1
    do
    begin
        aByte := BytePtr( ord4(dataPtr) + index)^;
        case aByte of
             0, 128:        aByte := ord('ø');
             8, 136:        aByte := ord('Δ');
            10, 138:        aByte := ord('◊');
            13, 141:        aByte := ord('¬');
            222 :             aByte := ord('∞');        { non-breaking space }
            33..126:         ;
            otherwise
                aByte := ord('¿');
        end;
        write (chr(aByte));
    end;
END;

function IntegerMax (a, b : integer) : integer;
begin
    if a < b then
        IntegerMax := b
    else
        IntegerMax := a;
end;

FUNCTION NumToHexStringF(theNumber: longint): str255;
    VAR
        tempStr: string[16];
        index: integer;
        digit1, digit2, digit3 : longint;
        hexStr : str255;
        mask : longint;
    BEGIN

    tempStr := '00000000';

    FOR index := 7 downto 0
    do
        begin
        mask := BSL ($F, 4 * index);
        digit1 := BAND (theNumber, mask);
        digit2 := BSR (digit1, 4*index);
        tempStr[8-index] := gHexStr[digit2+1];
        END;

    NumToHexStringF := tempStr;
    END;

PROCEDURE WWAddHexData (dataPtr : UNIV Ptr; dataSize : integer);
type
    BytePtr = ^Byte;            { this is unsigned! }
VAR
    offset, index : longint;
    result : str255;
    len : integer;
    byte : integer;
BEGIN
    if dataPtr = nil
    then
        begin
        writeln ('No data dump, NIL data ptr');
        exit (WWAddHexData);
        end;

    if dataSize <= 0
    then
        begin
        writeln ('No data dump, datesize <= 0');
        exit (WWAddHexData);
        end;

    offset := 0;

    while (offset < dataSize) do
    begin
        write ( NumToHexStringF (offset), ':');

        { Put it into a Str255 because it's faster to add one string to the window than it is to add 16 }
        result := '';
        for index := 0 to 15
        do
            if offset + index < dataSize
            then
                begin
                len := length(result);
                byte := BytePtr(ord4(dataPtr)+offset+index)^;
                result[len+1] := gHexStr[ BSR(byte, 4) + 1];
                result[len+2] := gHexStr[ BAND(byte, $F) + 1];
                result[len+3] := ' ';
                {$PUSH} {$R-} result[0] := chr(len + 3); {$POP}
                end
            else
                begin
                result[len+1] := ' ';
                result[len+2] := ' ';
                result[len+3] := ' ';
                {$PUSH} {$R-} result[0] := chr(len + 3); {$POP}
                end;
        write (result, '| ');

        WWAddEncodedText ( Ptr(ord4(dataPtr)+offset), IntegerMax(dataSize - offset, 16));

        offset := offset + 16;
    end;
END;

PROCEDURE WWShowWindow;
begin
    ShowWindow (gDebugWindowPtr);
end;